Exploratory analysis of Retail Trade Sales

Goals

  • Reproduce the Index of the Canadian Economic Dashboard and COVID-19
  • Identify data tables and vectors for the dashboard

Comments

suppressMessages(library(cansim))
suppressMessages(library(ggplot2))
suppressMessages(library(dplyr))
suppressMessages(library(plotly))
source("../../src/utils.R")

Extract the Data

vector_names <- c(
  "v65201210", "v41690973", "v2062809", "v1001827265",
  "v1001826653", "v52367097", "v4391505", "v800450",
  "v32858858", "v32858865", "v32858872", "v74869", "v129449",
  "v129460", "v129472", "v129482"
)
length(vector_names)
[1] 16
vector_descr <- c(
  "RealGDP", "CPI", "Employment [pers]", "Int. merchendise trade Exp. [$]",
  "Int. merchendise trade Imp. [$]", "Retail Sales [$]", "hours worked",
  "Manufact. sales [$]", "Aircraft domestic [#]", "Aircraft transborder [#]",
  "Aircraft int other [#]", "Railway carloads [tons]", "Travelers US [pers]",
  "Travelers other country [pers]", "CA resident US [pers]",
  "CAresident other country [pers]"
)
names(vector_descr) <- vector_names

I expect this date to be before the start of all time series/vectors.

start_date <- "1900-01-01"

Retrieve all vectors. They are concatunated along axis 0.

vectors <- get_cansim_vector(vector_names, start_date)
dim(vectors)
[1] 7559    9

Preprocessing

Normalization all indicators so that December 2019 = 100

colnames(vectors) <- sapply(colnames(vectors), tolower)
colnames(vectors) 
[1] "decimals"      "value"         "ref_date"      "releasetime"   "symbol"        "frequencycode" "scalar_id"     "coordinate"   
[9] "vector"       
vectors$ref_date = as.Date(vectors$ref_date)
head(vectors)
vector_names[1]
[1] "v65201210"
length(vector_names)
[1] 16
indicators1 <- vector(length=16)
for (i in 1:length(vector_names)) {
  indicator = filter(vectors, vector == vector_names[i])
  ref_value = indicator$value[indicator$ref_date == as.Date('2019-12-01')]
  indicator$value_index = 100. * indicator$value/ref_value
  if (i == 1) {indicators = indicator}
  else {indicators <- rbind(indicators, indicator)}
}
head(indicators)
indicators$descr <- sapply(indicators$vector, function(x) {
  vector_descr[x][[1]]
})

Canadian Economic Dashboard Visualization

p <- ggplot(indicators, aes(x=ref_date, y=value_index)) + geom_line((aes(group=descr, color=descr))) +
  scale_x_date(date_breaks="2 month", date_labels="%b %Y", limits = as.Date(c('2019-01-01','2020-06-01'))) + scale_y_continuous(breaks=seq(0, 180,20), limits= c(0, 180)) + labs(title='Index, December 2019=100', x='', y='')
ggplotly(p)
LS0tCnRpdGxlOiAiVGVzdFNldHVwIgpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sKIyBvdXRwdXQ6IHJtYXJrZG93bjo6Z2l0aHViX2RvY3VtZW50CiMgb3V0cHV0OiAKIyAgaHRtbF9kb2N1bWVudDoKIyAgICBrZWVwX21kOiB0cnVlCi0tLQoKIyBFeHBsb3JhdG9yeSBhbmFseXNpcyBvZiBSZXRhaWwgVHJhZGUgU2FsZXMKCiMjIyBHb2FscwoKKiBSZXByb2R1Y2UgdGhlIEluZGV4IG9mIHRoZSBDYW5hZGlhbiBFY29ub21pYyBEYXNoYm9hcmQgYW5kIENPVklELTE5CiogSWRlbnRpZnkgZGF0YSB0YWJsZXMgYW5kIHZlY3RvcnMgZm9yIHRoZSBkYXNoYm9hcmQKCiMjIyBDb21tZW50cwoKKiBUaW1lIHNlcmllcyBmcm9tIENhbmFkaWFuIEVjb25vbWljIERhc2hib2FyZCBhbmQgQ09WSUQtMTkgYXQgaHR0cHM6Ly93d3cxNTAuc3RhdGNhbi5nYy5jYS9uMS9wdWIvNzEtNjA3LXgvNzEtNjA3LXgyMDIwMDA5LWVuZy5odG0KKiBUaGVyZSBhcmUgMTYgaW5kaWNhdG9ycwoKCmBgYHtyfQpzdXBwcmVzc01lc3NhZ2VzKGxpYnJhcnkoY2Fuc2ltKSkKc3VwcHJlc3NNZXNzYWdlcyhsaWJyYXJ5KGdncGxvdDIpKQpzdXBwcmVzc01lc3NhZ2VzKGxpYnJhcnkoZHBseXIpKQpzdXBwcmVzc01lc3NhZ2VzKGxpYnJhcnkocGxvdGx5KSkKc291cmNlKCIuLi8uLi9zcmMvdXRpbHMuUiIpCmBgYAoKIyMgRXh0cmFjdCB0aGUgRGF0YQpgYGB7cn0KdmVjdG9yX25hbWVzIDwtIGMoCiAgInY2NTIwMTIxMCIsICJ2NDE2OTA5NzMiLCAidjIwNjI4MDkiLCAidjEwMDE4MjcyNjUiLAogICJ2MTAwMTgyNjY1MyIsICJ2NTIzNjcwOTciLCAidjQzOTE1MDUiLCAidjgwMDQ1MCIsCiAgInYzMjg1ODg1OCIsICJ2MzI4NTg4NjUiLCAidjMyODU4ODcyIiwgInY3NDg2OSIsICJ2MTI5NDQ5IiwKICAidjEyOTQ2MCIsICJ2MTI5NDcyIiwgInYxMjk0ODIiCikKbGVuZ3RoKHZlY3Rvcl9uYW1lcykKYGBgCgpgYGB7cn0KdmVjdG9yX2Rlc2NyIDwtIGMoCiAgIlJlYWxHRFAiLCAiQ1BJIiwgIkVtcGxveW1lbnQgW3BlcnNdIiwgIkludC4gbWVyY2hlbmRpc2UgdHJhZGUgRXhwLiBbJF0iLAogICJJbnQuIG1lcmNoZW5kaXNlIHRyYWRlIEltcC4gWyRdIiwgIlJldGFpbCBTYWxlcyBbJF0iLCAiaG91cnMgd29ya2VkIiwKICAiTWFudWZhY3QuIHNhbGVzIFskXSIsICJBaXJjcmFmdCBkb21lc3RpYyBbI10iLCAiQWlyY3JhZnQgdHJhbnNib3JkZXIgWyNdIiwKICAiQWlyY3JhZnQgaW50IG90aGVyIFsjXSIsICJSYWlsd2F5IGNhcmxvYWRzIFt0b25zXSIsICJUcmF2ZWxlcnMgVVMgW3BlcnNdIiwKICAiVHJhdmVsZXJzIG90aGVyIGNvdW50cnkgW3BlcnNdIiwgIkNBIHJlc2lkZW50IFVTIFtwZXJzXSIsCiAgIkNBcmVzaWRlbnQgb3RoZXIgY291bnRyeSBbcGVyc10iCikKbmFtZXModmVjdG9yX2Rlc2NyKSA8LSB2ZWN0b3JfbmFtZXMKYGBgCgpJIGV4cGVjdCB0aGlzIGRhdGUgdG8gYmUgYmVmb3JlIHRoZSBzdGFydCBvZiBhbGwgdGltZSBzZXJpZXMvdmVjdG9ycy4KYGBge3J9CnN0YXJ0X2RhdGUgPC0gIjE5MDAtMDEtMDEiCmBgYAoKUmV0cmlldmUgYWxsIHZlY3RvcnMuIFRoZXkgYXJlIGNvbmNhdHVuYXRlZCBhbG9uZyBheGlzIDAuCmBgYHtyfQp2ZWN0b3JzIDwtIGdldF9jYW5zaW1fdmVjdG9yKHZlY3Rvcl9uYW1lcywgc3RhcnRfZGF0ZSkKZGltKHZlY3RvcnMpCmBgYAoKCiMjIFByZXByb2Nlc3NpbmcKCk5vcm1hbGl6YXRpb24gYWxsIGluZGljYXRvcnMgc28gdGhhdCBEZWNlbWJlciAyMDE5ID0gMTAwCgpgYGB7cn0KY29sbmFtZXModmVjdG9ycykgPC0gc2FwcGx5KGNvbG5hbWVzKHZlY3RvcnMpLCB0b2xvd2VyKQpjb2xuYW1lcyh2ZWN0b3JzKQpgYGAKCmBgYHtyfQp2ZWN0b3JzJHJlZl9kYXRlIDwtIGFzLkRhdGUodmVjdG9ycyRyZWZfZGF0ZSkKYGBgCgoKYGBge3J9CmhlYWQodmVjdG9ycykKYGBgCgpgYGB7cn0KdmVjdG9yX25hbWVzWzFdCmBgYAoKYGBge3J9Cmxlbmd0aCh2ZWN0b3JfbmFtZXMpCmBgYAoKCmBgYHtyfQppbmRpY2F0b3JzMSA8LSB2ZWN0b3IobGVuZ3RoID0gMTYpCmZvciAoaSBpbiAxOnNlcV9sZW4odmVjdG9yX25hbWVzKSkgewogIGluZGljYXRvciA8LSBmaWx0ZXIodmVjdG9ycywgdmVjdG9yID09IHZlY3Rvcl9uYW1lc1tpXSkKICByZWZfdmFsdWUgPC0gaW5kaWNhdG9yJHZhbHVlW2luZGljYXRvciRyZWZfZGF0ZSA9PSBhcy5EYXRlKCIyMDE5LTEyLTAxIildCiAgaW5kaWNhdG9yJHZhbHVlX2luZGV4IDwtIDEwMC4gKiBpbmRpY2F0b3IkdmFsdWUgLyByZWZfdmFsdWUKICBpZiAoaSA9PSAxKSB7CiAgICBpbmRpY2F0b3JzIDwtIGluZGljYXRvcgogICAgfQogIGVsc2UgewogICAgaW5kaWNhdG9ycyA8LSByYmluZChpbmRpY2F0b3JzLCBpbmRpY2F0b3IpCiAgICB9Cn0KYGBgCgpgYGB7cn0KaGVhZChpbmRpY2F0b3JzKQpgYGAKCmBgYHtyfQppbmRpY2F0b3JzJGRlc2NyIDwtIHNhcHBseShpbmRpY2F0b3JzJHZlY3RvciwgZnVuY3Rpb24oeCkgewogIHZlY3Rvcl9kZXNjclt4XVtbMV1dCn0pCmBgYAoKCgoKIyMgQ2FuYWRpYW4gRWNvbm9taWMgRGFzaGJvYXJkIFZpc3VhbGl6YXRpb24KCmBgYHtyfQpwIDwtIGdncGxvdChpbmRpY2F0b3JzLCBhZXMoeCA9IHJlZl9kYXRlLCB5ID0gdmFsdWVfaW5kZXgpKSArCiAgZ2VvbV9saW5lKChhZXMoZ3JvdXAgPSBkZXNjciwgY29sb3IgPSBkZXNjcikpKSArCiAgc2NhbGVfeF9kYXRlKGRhdGVfYnJlYWtzID0gIjIgbW9udGgiLCBkYXRlX2xhYmVscyA9ICIlYiAlWSIsCiAgICAgICAgICAgICAgIGxpbWl0cyA9IGFzLkRhdGUoYygiMjAxOS0wMS0wMSIsICIyMDIwLTA2LTAxIikpKSArCiAgc2NhbGVfeV9jb250aW51b3VzKGJyZWFrcyA9IHNlcSgwLCAxODAsIDIwKSwgbGltaXRzID0gYygwLCAxODApKSArCiAgbGFicyh0aXRsZSA9ICJJbmRleCwgRGVjZW1iZXIgMjAxOSA9IDEwMCIsIHggPSAiIiwgeSA9ICIiKQpnZ3Bsb3RseShwKQpgYGAKCgo=